home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir35 / chkfl141.zip / CHKFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-13  |  7KB  |  313 lines
  1. { CheckFile v1.41 -- (c)1993 J Scott Hedspeth }
  2.  
  3. Program ChkFile;
  4.  
  5. {$M 3000,0,0}
  6.  
  7. Uses DOS,CRT;
  8.  
  9. Var
  10.    F, G     : Text;
  11.    FileName : String[12];
  12.    DirInfo  : SearchRec;
  13.    FileOK,
  14.    FileNO,
  15.    FileTotal,
  16.    N        : Integer;
  17.    Choice   : Char;
  18.    Reply,
  19.    FileLine,
  20.    NewFile  : String;
  21.    Mon, Yr,
  22.    Dy       : String[2];
  23.    AddFile  : File of Byte;
  24.    Size     : Longint;
  25.    Year,
  26.    Month,
  27.    Day,
  28.    DayofWeek: Word;
  29.  
  30. Const
  31.    Ver      = '-={ CheckFile v1.41 -- (c)1993 J Scott Hedspeth }=-';
  32.    InFile   = 'FILES.LST';
  33.    TempFile = 'FILES.)O(';
  34.  
  35. Procedure ShowMenu; Forward;
  36. Procedure ShowHelp; Forward;
  37.  
  38. Procedure ShowVer;
  39. Begin
  40.    ClrScr;
  41.    Writeln;
  42.    Writeln(' ',Ver);
  43.    Writeln;
  44. End;
  45.  
  46. Procedure ErrorMessage(Which : Byte);
  47.    Begin;
  48.       TextColor(Yellow);
  49.       ShowVer;
  50.       TextColor(Red);
  51.       Case Which Of
  52.         1 : Writeln(' Could not find FILES.LST!');
  53.         2 : Writeln(' Could not read FILES.LST!');
  54.       End;
  55.       TextColor(LightGray);
  56.       Writeln(^G);
  57.       Halt(1);
  58.     End;
  59. Procedure CheckFiles;
  60. Label
  61.    NextLine,LastLine;
  62. Begin
  63.    ClrScr;
  64.    ShowVer;
  65.    Writeln(' Reading FILES.LST...');
  66.    Writeln;
  67.    FileOK := 0;
  68.    FileNO := 0;
  69.    N := 6;
  70.    Assign(F,InFile);
  71.    {$I-}ReSet(F);{$I+};
  72.    If IOResult <> 0 Then ErrorMessage(2);
  73.    Repeat
  74. NextLine:
  75.       Readln(F,FileName);
  76.       If FileName = '            ' Then
  77.       Begin
  78.          If Not EOF(F) Then Goto NextLine;
  79.          If EOF(F) Then Goto LastLine;
  80.          End;
  81.       FindFirst(FileName,AnyFile,DirInfo);
  82.       If DOSError = 0  Then
  83.       Begin
  84.          GotoXY(1,N);
  85.          Write('     ',FileName,' OK');
  86.          Inc(FileOK);
  87.          End;
  88.       If DOSError <> 0 Then
  89.       Begin
  90.          GotoXY(1,N);
  91.          Write('     ',FileName,' NOT FOUND!  <enter>');
  92.          Readln(Reply);
  93.          Inc(FileNO);
  94.          Inc(N);
  95.          End;
  96. LastLine:
  97.    Until EOF(F);
  98.    Writeln;
  99.    Close(F);
  100.    Writeln;
  101.    Writeln(' Done!');
  102.    Writeln;
  103.    FileTotal := FileOK + FileNO;
  104.    Writeln(' FILES.LST contains ',FileTotal,' files,');
  105.    Writeln;
  106.    Writeln('  -->  ',FileOK,' file(s) located');
  107.    Writeln('  -->  ',FileNO,' file(s) missing');
  108.    Writeln;
  109.    Write(' <enter>');
  110.    Readln(Reply);
  111. End;
  112.  
  113. Procedure ClearList;
  114. Label
  115.    NextLine;
  116. Begin
  117.    ClrScr;
  118.    ShowVer;
  119.    Writeln(' Reading FILES.LST...');
  120.    Assign(F,InFile);
  121.    Assign(G,TempFile);
  122.    ReSet(F);
  123.    ReWrite(G);
  124.    Repeat
  125. NextLine:
  126.       Readln(F,FileLine);
  127.       If Copy(FileLine,35,12) = 'Uploaded By:' Then Goto NextLine;
  128.       Writeln(G,FileLine);
  129.    Until EOF(F);
  130.    Close(F);
  131.    Close(G);
  132.    Erase(F);
  133.    Writeln(' Writing FILES.$$$...');
  134.    Writeln(' Erasing FILES.LST...');
  135.    Rename(G,InFile);
  136.    Writeln(' Copying FILES.$$$ ==> FILES.LST...');
  137.    Writeln;
  138.    Writeln(' Done!');
  139.    Writeln;
  140.    Write(' <enter>');
  141.    Readln(Reply);
  142. End;
  143.  
  144. Procedure AddFiles;         
  145. Label
  146.    NextFile, NextLine, NoMore;
  147. Begin
  148. NextFile:
  149.    GetDate(Year,Month,Day,DayOfWeek);
  150.    Year := Year - 1900;
  151.    If Year > 99 Then
  152.       Year := Year - 100;
  153.    Str(Year:2, Yr);
  154.    Str(Month:2, Mon);
  155.    Str(Day:2, Dy);
  156.    If Yr[1]  = ' ' Then Yr[1]  := '0';
  157.    If Mon[1] = ' ' Then Mon[1] := '0';
  158.    If Dy[1]  = ' ' Then Dy[1]  := '0';
  159.    ClrScr;
  160.    ShowVer;
  161.    Writeln(' Enter blank line to quit.');
  162.    Writeln;
  163.    Write(' Enter filename to add: ');
  164.    Readln(NewFile);
  165.    For n := 1 to Length(NewFile) Do
  166.       NewFile[n] := UpCase(NewFile[n]);
  167.    If Length(NewFile) < 3 Then ShowMenu;
  168.    FindFirst(NewFile, AnyFile, DirInfo);
  169.    If DOSError <> 0 Then
  170.    Begin
  171.       Writeln;
  172.       Writeln(^G,' ',NewFile,' not found!');
  173.       Writeln;
  174.       Write(' <enter>');
  175.       Readln(Reply);
  176.       GoTo NextFile;
  177.    End;
  178.    Assign(AddFile,NewFile);
  179.    ReSet(AddFile);
  180.    Size := FileSize(AddFile);
  181.    Assign(G,InFile);
  182.    Append(G);
  183.    Write(G,NewFile);
  184.    For N := 1 to (16 - Length(NewFile)) Do
  185.       Write(G,' ');
  186.    Write(G,Size:6);
  187.    Write(G,'  ');
  188.    Write(G,Mon,'-',Dy,'-',Yr);
  189.    Write(G,'  ');
  190.    Writeln;
  191.    Writeln(' Enter a description for: ',NewFile);
  192.    Writeln(' |--------+---------+---------+---------|');
  193.    N := 10;
  194.    GotoXY(2,N);
  195.    Readln(FileLine);
  196.    If Length(FileLine) < 5 Then
  197.    Begin
  198.       Writeln(G,'No description given');
  199.       Goto NoMore;
  200.       End;
  201.    Writeln(G,FileLine);
  202. NextLine:
  203.    GotoXY(2,N+1);
  204.    Inc(N);
  205.    Readln(FileLine);
  206.    If Length(FileLine) < 5 Then Goto NoMore;
  207.    Writeln(G,'                                  ',FileLine);
  208.    Goto NextLine;
  209. NoMore:
  210.    Close(G);
  211.    Close(AddFile);
  212.    Writeln;
  213.    Writeln(' ',NewFile,' added to FILES.LST');
  214.    Writeln;
  215.    Write(' <enter>');
  216.    Readln(Reply);
  217.    GoTo NextFile;
  218. End;
  219.  
  220. Procedure ViewFiles;
  221. Begin
  222.    ClrScr;
  223.    Assign(F,InFile);
  224.    ReSet(F);
  225.    N := 1;
  226.    Repeat;
  227.       Readln(F,FileLine);
  228.       Writeln(' ',FileLine);
  229.       Inc(N);
  230.       If N >= 25 Then
  231.       Begin
  232.          Write(' <S>top, <enter> to continue: ');
  233.          Readln(Reply);
  234.          If (Reply = 's') or (Reply = 'S') Then ShowMenu;
  235.          N := 1;
  236.          End;
  237.    Until EOF(F);
  238.    Close(F);
  239.    Write(' <enter>');
  240.    Readln(Reply);
  241. End;
  242.  
  243. Procedure ShowExit;
  244. Begin
  245.    TextBackground(Black);
  246.    TextColor(LightGray);
  247.    ShowVer;
  248.    Halt(0);
  249. End;
  250.  
  251. Procedure ShowMenu;
  252. Begin
  253.    ClrScr;
  254.    Writeln;
  255.    Writeln('         ',Ver);
  256.    Writeln;
  257.    Writeln('         [A]dd file(s)               [I]nfo about CheckFile');
  258.    Writeln('         [L]ist FILES.LST            [Q]uit to DOS');
  259.    Writeln('         [R]emove "Uploaded by:"');
  260.    Writeln('         [V]erify FILES.LST');
  261.    Writeln;
  262.    Write('         Command: ');
  263.    Choice := ReadKey;
  264.    Choice := UpCase(Choice);
  265.    Case Choice of
  266.       'A' : AddFiles;
  267.       'I' : ShowHelp;
  268.       'L' : ViewFiles;
  269.       'R' : ClearList;
  270.       'V' : CheckFiles;
  271.       'Q' : ShowExit;
  272.       End;
  273.    ShowMenu;
  274. End;
  275.  
  276. Procedure ShowHelp;
  277. Begin
  278.    ClrScr;
  279.    ShowVer;
  280.    Writeln;
  281.    Writeln(' * CheckFile was written for use with TriBBS v4.0+.');
  282.    Writeln;
  283.    Writeln(' * CHKFILE.EXE must be in the current directory or your path statement.');
  284.    Writeln;
  285.    Writeln(' * CheckFile can: Verify the existence of files in FILES.LST');
  286.    Writeln('                  Remove the "Uploaded by:" line from FILES.LST');
  287.    Writeln('                  Add files to the current FILES.LST');
  288.    Writeln('                  View the current FILES.LST');
  289.    Writeln;
  290.    Writeln(' CheckFile is offered as FreeWare.  The author assumes no responsibility');
  291.    Writeln(' for anything, for any reason.  Use this program at your own risk.');
  292.    Writeln;
  293.    Writeln(' You may contact the author via:');
  294.    Writeln;
  295.    Writeln(' US Mail      Rt 4 Box 227  Mocksville, NC  27028');
  296.    Writeln(' WB4YZA BBS   704-284-4854    300 - 14,400 bps    v.32bis');
  297.    Writeln(' CompuServe   71042,3277');
  298.    Writeln;
  299.    Writeln;
  300.    Writeln;
  301.    Write(' <enter>');
  302.    Readln(Reply);
  303. End;
  304.  
  305. Begin
  306.    FindFirst(InFile,AnyFile,DirInfo);
  307.    IF DOSError <> 0 Then ErrorMessage(1);
  308.    TextBackground(Blue);
  309.    TextColor(Yellow);
  310.    If ParamStr(1) = '/?' Then ShowHelp;
  311.    ShowMenu;
  312. End.
  313.